home *** CD-ROM | disk | FTP | other *** search
/ Apple II Magazines (DO) / Peeker Nr. 15 (1986)(Verlag, Dr. Alfred Huethig)(DE).zip / Peeker Nr. 15 (1986)(Verlag, Dr. Alfred Huethig)(DE).do / STRINGDEMOS.txt < prev    next >
Text File  |  1996-12-24  |  9KB  |  288 lines
  1.  
  2. PROGRAM STRINGBEFEHLE;
  3.  
  4. CONST STRLEN  = 10; {Name 'STRLEN' erforderlich}
  5. TYPE  STRING  = ARRAY [1..STRLEN] OF CHAR; {Name 'STRING' erforderlich}
  6.  
  7. VAR   S, G, T, T1, T2: STRING; L, P, A: INTEGER; {Nur fuer Demo}
  8.  
  9. {========================================================================}
  10. {String-Include-Datei, zusammengestellt von U.Stiehl im Dez. 1985}
  11. {
  12. String-Befehle
  13. ==============
  14.  
  15. L := LENGTH (S);      Integer-Funktion: L wird geaendert
  16. G := CONCAT (T1,T2);  String-Funktion:  G wird geaendert
  17. P := POS (T,G);       Integer-Funktion: P wird geaendert
  18. T := COPY (G,P,A);    String-Funktion:  T wird geaendert
  19. DELETE (G,P,A);       String-Prozedur:  G wird geaendert
  20. INSERT (T,G,P);       String-Prozedur:  G wird geaendert
  21.  
  22. S = String,    G = Gesamtstring,   T = Teilstring, ferner T1 und T2
  23. L = Laenge,    P = Position,       A = Anzahl der Zeichen
  24.  
  25. Im Hauptprogrammkopf muessen definiert werden:
  26. als CONST STRLEN mit Integer-Wert >= 2,
  27. als TYPE  STRING mit 1..STRLEN.
  28. }
  29. {------------------------------------------------------------------------}
  30. {
  31. LENGTH ermittelt Netto-Laenge ohne Leertasten am String-Ende, d.h.
  32. Leertasten links werden mitgezaehlt, Leertasten rechts abgezogen.
  33. Aufrufen mit L := LENGTH (S). Beispiele:
  34.  
  35.       123  Zaehlleiste
  36. S := 'abc' L = 3: Keine Leertasten.
  37. S := '   ' L = 0: Nur Leertasten = Nullstring.
  38. S := 'a  ' L = 1: Leertasten rechts entfernt.
  39. S := ' a ' L = 2: Fuehrende Leertaste zaehlt mit.
  40. S := 'a c' L = 3: Leertaste in der Mitte zaehlt mit.
  41. }
  42. FUNCTION LENGTH (S:STRING):INTEGER;
  43. VAR L:INTEGER;
  44. BEGIN
  45.  L := STRLEN; WHILE (S[L] = ' ') AND (L > 1) DO L := L - 1;
  46.  IF (L = 1) AND (S[1] = ' ') THEN LENGTH := 0 ELSE LENGTH := L
  47. END;
  48. {------------------------------------------------------------------------}
  49. {
  50. CONCAT vereinigt die 2 Teilstrings T1 und T2 zu einem Gesamtstring G.
  51. Aufrufen mit G := CONCAT (T1,T2). Beispiel:
  52.  
  53.  1234567890  Zaehlleiste
  54.       P
  55. 'abcde     ' T1
  56. 'fghij     ' T2
  57. 'abcde     ' Zunaechst T1 in G ab P = 1
  58. 'abcdefghij' Dannn T2 in G ab P = 6
  59.  
  60. Wenn T1 und T2 nicht zusammen in G passen, wird zunaechst T1 in G kopiert
  61. und dann soviel von T2, wie in G noch Platz ist.
  62. }
  63. FUNCTION CONCAT (T1,T2: STRING):STRING;
  64. VAR I,J,P:INTEGER; G:STRING;
  65. BEGIN
  66.  P := 0;
  67.  FOR I := 1 TO STRLEN DO
  68.  BEGIN
  69.   G[I] := T1[I]; {T1 ab links in G kopieren}
  70.   IF (G[I] <> ' ') THEN P := I
  71.  END;
  72.  J := 1;
  73.  FOR I := P TO STRLEN-1 DO
  74.  BEGIN
  75.   G[I+1] := T2[J]; {T2 ab Leertasten in G kopieren}
  76.   J := J + 1
  77.  END;
  78.  CONCAT := G
  79. END;
  80. {------------------------------------------------------------------------}
  81. {
  82. POS ermittelt die Position P des Teilstrings T im Gesamtstring G.
  83. Wenn T in G nicht enthalten ist, wir P auf 0 gesetzt.
  84. Aufrufen mit P := POS (T,G). Beispiel:
  85.  
  86.  123456  Zaehlleiste
  87.   P      P errechnet
  88. 'Peeker' G
  89. 'ee    ' T, ab P in G
  90. }
  91. FUNCTION POS (T,G: STRING):INTEGER;
  92. VAR I,J,L:INTEGER; F: BOOLEAN; 
  93. BEGIN
  94.  L := STRLEN;
  95.  WHILE (T[L] = ' ') AND (L <> 1) DO L := L - 1; {Laenge von T}
  96.  I := 0; {Zaehler fuer G}
  97.  REPEAT
  98.   J := 1; {Zaehler fuer T}
  99.   F := TRUE; {Flag}
  100.   WHILE (J <= L) DO
  101.   BEGIN
  102.    IF (G[I+J] <> T[J]) THEN F := FALSE; 
  103.    J := J + 1;
  104.   END;
  105.   I := I + 1
  106.  UNTIL (F = TRUE) OR (L+I > STRLEN);
  107.  IF (F = TRUE) THEN POS := I ELSE POS := 0
  108. END;
  109. {------------------------------------------------------------------------}
  110. {
  111. COPY = Substring = Instring extrahiert Teilstring T aus Gesamtstring G ab
  112. Position P in der Anzahl A; bei fehlerhaften Parametern soweit wie moeglich.
  113. Aufrufen mit T := COPY (G,P,A). Beispiel: T := COPY (G,4,3)
  114.  
  115.  123456  Zaehlleiste
  116.     P    P = 4
  117.     123  A = 3
  118. 'Pascal' G
  119. 'cal   ' T
  120. }
  121. FUNCTION COPY (G:STRING; P,A:INTEGER):STRING;
  122. VAR I:INTEGER; T:STRING;
  123. BEGIN
  124.  FOR I := 1 TO STRLEN DO T[I] := ' '; {Loeschen}
  125.  FOR I := 1 TO A DO {Wenn A < 1, dann Exit!}
  126.  IF (P+I <= STRLEN+1) AND (P>0) THEN T[I] := G[P+I-1];
  127.  COPY := T
  128. END;
  129. {------------------------------------------------------------------------}
  130. {
  131. DELETE entfernt aus Gesamtstring G die Anzahl A Zeichen ab Position P. Danach
  132. ist G rechts mit der Anzahl A Leerzeichen aufgefuellt. Bei zu groessen Werten
  133. von P und A wird entfernt und geloescht, soweit es geht.
  134. Aufrufen mit DELETE (G,P,A). Beispiel: DELETE (G,5,5)
  135.  
  136.  1234567890  Zaehlleiste
  137.      P       P = 5
  138.      12345   A = 5
  139. 'Kyan-Kurs:' G vorher
  140. 'Kyan:     ' G nachher
  141. }
  142. PROCEDURE DELETE (VAR G: STRING; P,A: INTEGER);
  143. VAR I: INTEGER;
  144. BEGIN
  145. IF (P<1) THEN P := 1; IF (P > STRLEN) THEN P := STRLEN; {illegaler P-Wert}
  146. WHILE (P+A > STRLEN+1) DO A := A - 1; {illegaler A-Wert}
  147. FOR I := P TO STRLEN-1 DO IF (I+A <= STRLEN)
  148.  THEN G[I] := G[I+A] ELSE G[I] := ' ';
  149. FOR I := STRLEN DOWNTO STRLEN-P+1 DO IF (I>0) THEN G[I] := ' '
  150. END;
  151. {-----------------------------------------------------------------------}
  152. {
  153. INSERT fuegt den Teilstring T in den Gesamtstring G ab Position P ein.
  154. Wenn P zu gross ist, wird G von rechts entsprechend gekuerzt.
  155. Aufrufen mit INSERT (T,G,P). Beispiel INSERT (T,G,5)
  156.  
  157.  1234567890  Zaehlleiste
  158.     P        P = 4
  159. 'einen     ' G vorher
  160. 'fueg      ' T
  161. 'einfuegen ' G nachher
  162. }
  163. PROCEDURE INSERT (T: STRING; VAR G: STRING; P:INTEGER);
  164. VAR I,J,L:INTEGER;
  165. BEGIN
  166. IF (P<1) THEN P := 1; IF (P>STRLEN) THEN P := STRLEN; {Fehler}
  167. L := STRLEN; WHILE (T[L] = ' ') AND (L>1) DO L := L - 1; 
  168. IF (L<>1) OR (T[1] <> ' ') THEN {T als Nullstring ignorieren}
  169.  BEGIN
  170.  J := 1;
  171.  WHILE (P <= STRLEN) AND (J <= L) DO
  172.   BEGIN
  173.    FOR I := STRLEN-1 DOWNTO P DO G[I+1] := G[I]; 
  174.    G[P] := T[J]; P := P + 1; J := J + 1
  175.   END
  176.  END
  177. END;
  178. {=======================================================================}
  179. {Demos}
  180.  
  181. BEGIN
  182. WRITELN ('Kurzbeispiele-------------------------------------------');
  183. WRITELN (LENGTH ('PASCAL    '));
  184. G := CONCAT ('PAS       ', 'CAL       '); WRITELN (G:LENGTH (G));
  185. WRITELN (POS ('CAL       ', 'PASCAL    '));
  186. WRITELN (COPY ('PASCAL    ', 2,3));
  187. G := 'PASCAL    '; DELETE (G,2,3); WRITELN (G:LENGTH (G));
  188. INSERT ('ASC       ',G,2); WRITELN (G:LENGTH (G));
  189.  
  190. WRITELN ('Length-Demo --------------------------------------------');
  191.      {1234567890 Zaehlleiste}
  192. S := 'ABCDEFGHIJ'; L := LENGTH (S); WRITELN (L); {10}
  193. S := 'A         '; L := LENGTH (S); WRITELN (L); {1}
  194. S := '          '; L := LENGTH (S); WRITELN (L); {0}
  195. S := ' A A A A A'; L := LENGTH (S); WRITELN (L); {10}
  196.  
  197. WRITELN ('Concat-Demo -------------------------------------------');
  198.       {1234567890 Zaehlleiste}
  199. T1 := 'ABCDE     ';
  200. T2 := 'FGHIJ     '; G := CONCAT (T1,T2); WRITELN (G);
  201.      {'ABCDEFGHIJ'}
  202. T1 := '          ';
  203. T2 := 'FGHIJ     '; G := CONCAT (T1,T2); WRITELN (G);
  204.      {'FGHIJ     '}
  205. T1 := 'ABCDE     ';
  206. T2 := '          '; G := CONCAT (T1,T2); WRITELN (G);
  207.      {'ABCDE     '}
  208. T1 := '         A';
  209. T2 := '         B'; G := CONCAT (T1,T2); WRITELN (G);
  210.      {'         A' Fehler}
  211. T1 := 'ABCDEFGHI ';
  212. T2 := 'ABCDEFGHIJ'; G := CONCAT (T1,T2); WRITELN (G);
  213.      {'ABCDEFGHIA' Fehler}
  214. T1 := '          ';
  215. T2 := '          '; G := CONCAT (T1,T2); WRITELN (G, '*')
  216.     ;{'          '}
  217.  
  218. WRITELN ('Pos-Demo --------------------------------------------');
  219.      {1234567890 Zaehlleiste}
  220. G := 'ABCDEFGHIJ';
  221. T := 'BC        '; P := POS (T,G); WRITELN (P); {2}
  222. G := 'ABCDEFGHIJ';
  223. T := 'EFGHIJ    '; P := POS (T,G); WRITELN (P); {5}
  224. G := '          ';
  225. T := '          '; P := POS (T,G); WRITELN (P); {1}
  226. G := 'AAAAAAAAAA';
  227. T := 'A         '; P := POS (T,G); WRITELN (P); {1}
  228. G := 'AAAAAAAAAA';
  229. T := 'B         '; P := POS (T,G); WRITELN (P); {0}
  230. G := '         A';
  231. T := '         A'; P := POS (T,G); WRITELN (P); {1}
  232.  
  233. WRITELN ('Copy-Demo -------------------------------------------');
  234.      {1234567890 Zaehlleiste}
  235. G := 'ABCDEFGHIJ';
  236. T := COPY (G,1,5); WRITELN (T); {'ABCDE'}
  237. T := COPY (G,6,5); WRITELN (T); {'FGHIJ'}
  238. T := COPY (G,9,8); WRITELN (T); {'IJ', Teilkopie}
  239. T := COPY (G,0,8); WRITELN (T, '*'); {fehlerhaft}
  240. T := COPY (G,0,0); WRITELN (T, '*'); {fehlerhaft}
  241.  
  242. WRITELN ('Delete-Demo -----------------------------------------');
  243.      {1234567890 Zaehlleiste}
  244. G := 'ABCDEFGHIJ'; DELETE (G,1,10); WRITELN (G, '*');
  245.     {'          '}
  246. G := 'ABCDEFGHIJ'; DELETE (G,5,5); WRITELN (G);
  247.     {'ABCDJ     '}
  248. G := 'ABCDEFGHIJ'; DELETE (G,2,2); WRITELN (G);
  249.     {'ADEFGHIJ  '}
  250. G := '         A'; DELETE (G,1,9); WRITELN (G);
  251.     {'A         '}
  252. G := 'A         '; DELETE (G,1,1); WRITELN (G, '*');
  253.     {'          '}
  254.  
  255. WRITELN ('Insert-Demo -----------------------------------------');
  256.      {1234567890 Zaehlleiste}
  257. G := 'ABCDEJ    ';
  258. T := 'FGHI      '; INSERT (T,G,6); WRITELN (G);
  259.     {'ABCDEFGHIJ'}
  260. G := 'J         ';
  261. T := 'ABCDEFGHI '; INSERT (T,G,1); WRITELN (G);
  262.     {'ABCDEFGHIJ'}         
  263. G := '     FGHIJ'; {Fuehrende Leertasten gelten!}
  264. T := 'ABCDE     '; INSERT (T,G,1); WRITELN (G);
  265.     {'ABCDE     '  Fehler}
  266. G := '      AAA ';
  267. T := 'BBB       '; INSERT (T,G,7); WRITELN (G);
  268.     {'      BBBA'  Fehler}
  269. G := '          ';
  270. T := 'ABC       '; INSERT (T,G,5); WRITELN (G);
  271.     {'    ABC   '}
  272.  
  273. WRITELN ('Leertasten eliminieren-------------------------------');
  274.  
  275. S := 'Peeker    ';
  276. WRITELN (S:LENGTH (S), '/');
  277. {sicherer:} IF LENGTH (S) > 0 THEN WRITELN (S:LENGTH (S), '/');
  278.  
  279. S := CONCAT ('Daten     ', 'typ       ');
  280. WRITELN (S:LENGTH (S), '/');
  281. {sicherer:} IF LENGTH (S) > 0 THEN WRITELN (S:LENGTH (S), '/');
  282.  
  283. S := 'Leftstring'; {hier die ersten 4 Zeichen}
  284. WRITELN (S, '/');
  285. IF LENGTH (S) > 4 THEN WRITELN (S:4, '/')
  286.  
  287. END.
  288.